home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 2003 August / MW 8 2003 CD1.iso / Inside Macworld / Product News / gimp-1.2.4.sit / gimp-1.2.4 / plug-ins / perl / Gimp / Fu.pm < prev    next >
Encoding:
Perl POD Document  |  2003-01-14  |  28.6 KB  |  925 lines
  1. package Gimp::Fu;
  2.  
  3. use Gimp ('croak', '__');
  4. use Gimp::Data;
  5. use File::Basename;
  6.  
  7. require Exporter;
  8.  
  9. =head1 NAME
  10.  
  11. Gimp::Fu - "easy to use" framework for Gimp scripts
  12.  
  13. =head1 SYNOPSIS
  14.  
  15.   use Gimp;
  16.   use Gimp::Fu;
  17.  
  18.   (this module uses Gtk, so make sure it's correctly installed)
  19.  
  20. =head1 DESCRIPTION
  21.  
  22. Currently, there are only three functions in this module. This
  23. fully suffices to provide a professional interface and the
  24. ability to run this script from within the Gimp and standalone
  25. from the commandline.
  26.  
  27. Dov Grobgeld has written an excellent tutorial for Gimp-Perl. While not
  28. finished, it's definitely worth a look! You can find it at
  29. C<http://imagic.weizmann.ac.il/~dov/gimp/perl-tut.html>.
  30.  
  31. =head1 INTRODUCTION
  32.  
  33. In general, a Gimp::Fu script looks like this:
  34.  
  35.    #!/path/to/your/perl
  36.  
  37.    use Gimp;
  38.    use Gimp::Fu;
  39.  
  40.    register <many arguments>, sub {
  41.       your code;
  42.    }
  43.  
  44.    exit main;
  45.  
  46. (This distribution comes with example scripts. One is
  47. C<examples/example-fu.pl>, which is small Gimp::Fu-script you can take as
  48. starting point for your experiments)
  49.  
  50. =cut
  51.  
  52. sub PF_INT8    () { Gimp::PDB_INT8    };
  53. sub PF_INT16    () { Gimp::PDB_INT16    };
  54. sub PF_INT32    () { Gimp::PDB_INT32    };
  55. sub PF_FLOAT    () { Gimp::PDB_FLOAT    };
  56. sub PF_STRING    () { Gimp::PDB_STRING    };
  57. sub PF_COLOR    () { Gimp::PDB_COLOR    };
  58. sub PF_COLOUR    () { Gimp::PDB_COLOR    };
  59. sub PF_IMAGE    () { Gimp::PDB_IMAGE    };
  60. sub PF_LAYER    () { Gimp::PDB_LAYER    };
  61. sub PF_CHANNEL    () { Gimp::PDB_CHANNEL    };
  62. sub PF_DRAWABLE    () { Gimp::PDB_DRAWABLE    };
  63.  
  64. sub PF_TOGGLE    () { Gimp::PDB_END+1    };
  65. sub PF_SLIDER    () { Gimp::PDB_END+2    };
  66. sub PF_FONT    () { Gimp::PDB_END+3    };
  67. sub PF_SPINNER    () { Gimp::PDB_END+4    };
  68. sub PF_ADJUSTMENT(){ Gimp::PDB_END+5    }; # compatibility fix for script-fu _ONLY_
  69. sub PF_BRUSH    () { Gimp::PDB_END+6    };
  70. sub PF_PATTERN    () { Gimp::PDB_END+7    };
  71. sub PF_GRADIENT    () { Gimp::PDB_END+8    };
  72. sub PF_RADIO    () { Gimp::PDB_END+9    };
  73. sub PF_CUSTOM    () { Gimp::PDB_END+10    };
  74. sub PF_FILE    () { Gimp::PDB_END+11    };
  75. sub PF_TEXT    () { Gimp::PDB_END+12    };
  76.  
  77. sub PF_BOOL    () { PF_TOGGLE        };
  78. sub PF_INT    () { PF_INT32        };
  79. sub PF_VALUE    () { PF_STRING        };
  80.  
  81. sub Gimp::RUN_FULLINTERACTIVE (){ Gimp::RUN_INTERACTIVE+100 };    # you don't want to know
  82.  
  83. %pf_type2string = (
  84.          &PF_INT8    => 'small integer',
  85.          &PF_INT16    => 'medium integer',
  86.          &PF_INT32    => 'integer',
  87.          &PF_FLOAT    => 'value',
  88.          &PF_STRING    => 'string',
  89.          &PF_BRUSH    => 'string',
  90.          &PF_GRADIENT    => 'string',
  91.          &PF_PATTERN    => 'string',
  92.          &PF_COLOR    => 'colour',
  93.          &PF_FONT    => 'XLFD',
  94.          &PF_TOGGLE    => 'boolean',
  95.          &PF_SLIDER    => 'integer',
  96.          &PF_SPINNER    => 'integer',
  97.          &PF_ADJUSTMENT    => 'integer',
  98.          &PF_RADIO    => 'string',
  99.          &PF_CUSTOM    => 'string',
  100.          &PF_FILE    => 'string',
  101.          &PF_TEXT    => 'string',
  102.          &PF_IMAGE    => 'path',
  103.          &PF_LAYER    => 'index',
  104.          &PF_CHANNEL    => 'index',
  105.          &PF_DRAWABLE    => 'index',
  106. );
  107.  
  108. @_params=qw(PF_INT8 PF_INT16 PF_INT32 PF_FLOAT PF_VALUE PF_STRING PF_COLOR
  109.             PF_COLOUR PF_TOGGLE PF_IMAGE PF_DRAWABLE PF_FONT PF_LAYER
  110.             PF_CHANNEL PF_BOOL PF_SLIDER PF_INT PF_SPINNER PF_ADJUSTMENT
  111.             PF_BRUSH PF_PATTERN PF_GRADIENT PF_RADIO PF_CUSTOM PF_FILE
  112.             PF_TEXT);
  113.  
  114. #@EXPORT_OK = qw($run_mode save_image);
  115.  
  116. sub import {
  117.    local $^W=0;
  118.    my $up = caller;
  119.    shift;
  120.    @_ = (qw(register main),@_params) unless @_;
  121.    for (@_) {
  122.       if ($_ eq ":params") {
  123.          push (@_, @_params);
  124.       } else {
  125.          *{"${up}::$_"} = \&$_;
  126.       }
  127.    }
  128. }
  129.  
  130. sub carp {
  131.    require Carp;
  132.    goto &Carp::carp;
  133. }
  134.  
  135. # Some Standard Arguments
  136. my @image_params = ([&Gimp::PDB_IMAGE        , "image",    "The image to work on"],
  137.                     [&Gimp::PDB_DRAWABLE    , "drawable",    "The drawable to work on"]);
  138.  
  139. my @load_params  = ([&Gimp::PDB_STRING    , "filename",    "The name of the file"],
  140.                     [&Gimp::PDB_STRING    , "raw_filename","The name of the file"]);
  141.  
  142. my @save_params  = (@image_params, @load_params);
  143.  
  144. my @load_retvals = ([&Gimp::PDB_IMAGE        , "image",    "Output image"]);
  145.  
  146. my $image_retval = [&Gimp::PDB_IMAGE        , "image",    "The resulting image"];
  147.  
  148. # expand all the pod directives in string (currently they are only removed)
  149. sub expand_podsections() {
  150.    my $pod;
  151.    for (@scripts) {
  152.       $_->[2] ||= "=pod(NAME)";
  153.       $_->[3] ||= "=pod(HELP)";
  154.       $_->[4] ||= "=pod(AUTHOR)";
  155.       $_->[5] ||= "=pod(AUTHOR)";
  156.       $_->[6] ||= "=pod(DATE)";
  157.  
  158.       for (@{$_}[2,3,4,5,6]) {
  159.          s/=pod\(([^)]*)\)/
  160.             require Gimp::Pod;
  161.             $pod ||= new Gimp::Pod;
  162.             $pod->section($1) || $pod->format;
  163.          /eg;
  164.       }
  165.    }
  166. }
  167.  
  168. # the old value of the trace flag
  169. my $old_trace;
  170.  
  171. sub interact {
  172.    eval { require Gtk };
  173.  
  174.    if ($@) {
  175.       my @res = map {
  176.          die __"the gtk perl module is required to run\nthis plug-in in interactive mode\n" unless defined $_->[3];
  177.          $_->[3];
  178.       } @types;
  179.       Gimp::logger(message => __"the gtk perl module is required to open a dialog\nwindow, running with default values",
  180.                    fatal => 1, function => $function);
  181.       return (1,@res);
  182.    }
  183.  
  184.    require Gimp::UI;
  185.    goto &Gimp::UI::interact;
  186. }
  187.  
  188. sub fu_feature_present($$) {
  189.    my ($feature,$function)=@_;
  190.    require Gimp::Feature;
  191.    if (Gimp::Feature::present($feature)) {
  192.       1;
  193.    } else {
  194.       Gimp::Feature::missing(Gimp::Feature::describe($feature),$function);
  195.       0;
  196.    }
  197. }
  198.  
  199. sub this_script {
  200.    return $scripts[0] unless $#scripts;
  201.    # well, not-so-easy-day today
  202.    require File::Basename;
  203.    my $exe = File::Basename::basename($0);
  204.    my @names;
  205.    for my $this (@scripts) {
  206.       my $fun = (split /\//,$this->[1])[-1];
  207.       $fun =~ s/^(?:perl_fu|plug_in)_//;
  208.       return $this if lc($exe) eq lc($fun);
  209.       push(@names,$fun);
  210.    }
  211.    die __"function '$exe' not found in this script (must be one of ".join(", ",@names).")\n";
  212. }
  213.  
  214. my $latest_image;
  215.  
  216. sub string2pf($$) {
  217.    my($s,$type,$name,$desc)=($_[0],@{$_[1]});
  218.    if($type==PF_STRING
  219.       || $type==PF_FONT
  220.       || $type==PF_PATTERN
  221.       || $type==PF_BRUSH
  222.       || $type==PF_CUSTOM
  223.       || $type==PF_FILE
  224.       || $type==PF_TEXT
  225.       || $type==PF_RADIO    # for now! #d#
  226.       || $type==PF_GRADIENT) {
  227.       $s;
  228.    } elsif($type==PF_INT8
  229.            || $type==PF_INT16
  230.            || $type==PF_INT32
  231.            || $type==PF_SLIDER
  232.            || $type==PF_SPINNER
  233.            || $type==PF_ADJUSTMENT) {
  234.       die __"$s: not an integer\n" unless $s==int($s);
  235.       $s*1;
  236.    } elsif($type==PF_FLOAT) {
  237.       $s*1;
  238.    } elsif($type==PF_COLOUR) {
  239.       $s=Gimp::canonicalize_colour($s);
  240.    } elsif($type==PF_TOGGLE) {
  241.       $s?1:0;
  242.    #} elsif($type==PF_IMAGE) {
  243.    } else {
  244.       die __"conversion to type $pf_type2string{$type} is not yet implemented\n";
  245.    }
  246. }
  247.  
  248. # set options read from the command line
  249. my $outputfile;
  250.  
  251. # mangle argument switches to contain only a-z0-9 and the underscore,
  252. # for easier typing.
  253. sub mangle_key {
  254.    my $key = shift;
  255.    $key=~y/A-Z /a-z_/;
  256.    $key=~y/a-z0-9_//cd;
  257.    $key;
  258. }
  259.  
  260. Gimp::on_net {
  261.    no strict 'refs';
  262.    my $this = this_script;
  263.    my(%map,@args);
  264.    my($interact)=1;
  265.  
  266.    my($perl_sub,$function,$blurb,$help,$author,$copyright,$date,
  267.       $menupath,$imagetypes,$params,$results,$features,$code,$type)=@$this;
  268.  
  269.    for(@$features) {
  270.       return unless fu_feature_present($_, $function);
  271.    }
  272.  
  273.    # %map is a hash that associates (mangled) parameter names to parameter index
  274.    @map{map mangle_key($_->[1]), @{$params}} = (0..$#{$params});
  275.  
  276.    # Parse the command line
  277.    while(defined($_=shift @ARGV)) {
  278.       if (/^-+(.*)$/) {
  279.      if($1 eq "i" or $1 eq "interact") {
  280.        $interact=1e6;
  281.      } elsif($1 eq "o" or $1 eq "output") {
  282.        $outputfile=shift @ARGV;
  283.      } elsif($1 eq "info") {
  284.        print __"no additional information available, use --help\n";
  285.        exit 0;
  286.      } else {
  287.            my $arg=shift @ARGV;
  288.        my $idx=$map{$1};
  289.        die __"$_: illegal switch, try $0 --help\n" unless defined($idx);
  290.        $args[$idx]=string2pf($arg,$params->[$idx]);
  291.        $interact--;
  292.      }
  293.       } else {
  294.          push(@args,string2pf($_,$params->[@args]));
  295.      $interact--;
  296.       }
  297.    }
  298.  
  299.    # Fill in default arguments
  300.    foreach my $i (0..@$params-1) {
  301.        next if defined $args[$i];
  302.        my $entry = $params->[$i];
  303.        $args[$i] = $entry->[3];             # Default value
  304.        die __"parameter '$entry->[1]' is not optional\n" unless defined $args[$i] || $interact>0;
  305.    }
  306.  
  307.    # Go for it
  308.    $perl_sub->(($interact>0 ? &Gimp::RUN_FULLINTERACTIVE : &Gimp::RUN_NONINTERACTIVE),
  309.                @args);
  310. };
  311.  
  312. Gimp::on_query {
  313.    expand_podsections;
  314.    script:
  315.    for(@scripts) {
  316.       my($perl_sub,$function,$blurb,$help,$author,$copyright,$date,
  317.          $menupath,$imagetypes,$params,$results,$features,$code,$type,
  318.          $defargs)=@$_;
  319.  
  320.       for (@$results) {
  321.          next if ref $_;
  322.          if ($_ == &Gimp::PDB_IMAGE) {
  323.             $_ = $image_retval;
  324.          }
  325.       }
  326.  
  327.       for(@$features) {
  328.          next script unless fu_feature_present($_,$function);
  329.       }
  330.  
  331.       # guess the datatype. yeah!
  332.       sub datatype(@) {
  333.          for(@_) {
  334.             return Gimp::PDB_STRING unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; # perlfaq4
  335.             return Gimp::PDB_FLOAT  unless /^[+-]?\d+$/; # again
  336.          }
  337.          return Gimp::PDB_INT32;
  338.       }
  339.       sub odd_values(@) {
  340.          my %x = @_; values %x;
  341.       }
  342.  
  343.       for(@$params) {
  344.          $_->[0]=Gimp::PDB_INT32    if $_->[0] == PF_TOGGLE;
  345.          $_->[0]=Gimp::PDB_STRING    if $_->[0] == PF_FONT;
  346.          $_->[0]=Gimp::PDB_STRING    if $_->[0] == PF_BRUSH;
  347.          $_->[0]=Gimp::PDB_STRING    if $_->[0] == PF_PATTERN;
  348.          $_->[0]=Gimp::PDB_STRING    if $_->[0] == PF_GRADIENT;
  349.          $_->[0]=Gimp::PDB_STRING    if $_->[0] == PF_CUSTOM;
  350.          $_->[0]=Gimp::PDB_STRING    if $_->[0] == PF_FILE;
  351.          $_->[0]=Gimp::PDB_STRING    if $_->[0] == PF_TEXT;
  352.          $_->[0]=datatype(odd_values(@{$_->[4]})) if $_->[0] == PF_RADIO;
  353.          $_->[0]=datatype($_->[3],@{$_->[4]}) if $_->[0] == PF_SLIDER;
  354.          $_->[0]=datatype($_->[3],@{$_->[4]}) if $_->[0] == PF_SPINNER;
  355.          $_->[0]=datatype($_->[3],@{$_->[4]}) if $_->[0] == PF_ADJUSTMENT;
  356.       }
  357.  
  358.       # Gtk not installed -> do not install menu entry
  359.       if (@$params > $defargs) {
  360.          require Gimp::Feature;
  361.          undef $menupath unless Gimp::Feature::present('gtk');
  362.       }
  363.       
  364.       Gimp->gimp_install_procedure($function,$blurb,$help,$author,$copyright,$date,
  365.                                    $menupath,$imagetypes,$type,
  366.                                    [[Gimp::PDB_INT32,"run_mode","Interactive, [non-interactive]"],
  367.                                     @$params],
  368.                                    $results);
  369.  
  370.       Gimp::logger(message => 'OK', function => $function, fatal => 0);
  371.    }
  372. };
  373.  
  374. =cut
  375.  
  376. =head2 THE REGISTER FUNCTION
  377.  
  378.    register
  379.      "function_name",
  380.      "blurb", "help",
  381.      "author", "copyright",
  382.      "date",
  383.      "menu path",
  384.      "image types",
  385.      [
  386.        [PF_TYPE,name,desc,optional-default,optional-extra-args],
  387.        [PF_TYPE,name,desc,optional-default,optional-extra-args],
  388.        # etc...
  389.      ],
  390.      [
  391.        # like above, but for return values (optional)
  392.      ],
  393.      ['feature1', 'feature2'...], # optionally check for features
  394.      sub { code };
  395.  
  396. =over 2
  397.  
  398. =item function name
  399.  
  400. The pdb name of the function, i.e. the name under which is will be
  401. registered in the Gimp database. If it doesn't start with "perl_fu_",
  402. "file_", "plug_in_" or "extension_", it will be prepended. If you
  403. don't want this, prefix your function name with a single "+". The idea
  404. here is that every Gimp::Fu plug-in will be found under the common
  405. C<perl_fu_>-prefix.
  406.  
  407. =item blurb
  408.  
  409. A small description of this script/plug-in. Defaults to "=pod(NAME)" (see
  410. the section on EMBEDDED POD DOCUMENTATION for an explanation of this
  411. string).
  412.  
  413. =item help
  414.  
  415. A help text describing this script. Should be longer and more verbose than
  416. C<blurb>. Default is "=pod(HELP)".
  417.  
  418. =item author
  419.  
  420. The name (and also the e-mail address if possible!) of the
  421. script-author. Default is "=pod(AUTHOR)".
  422.  
  423. =item copyright
  424.  
  425. The copyright designation for this script. Important! Safe your intellectual
  426. rights! The default is "=pod(AUTHOR)".
  427.  
  428. =item date
  429.  
  430. The "last modified" time of this script. There is no strict syntax here, but
  431. I recommend ISO format (yyyymmdd or yyyy-mm-dd). Default value is "=pod(DATE)".
  432.  
  433. =item menu path
  434.  
  435. The menu entry Gimp should create. It should start either with <Image>, if
  436. you want an entry in the image menu (the one that opens when clicking into
  437. an image), <Xtns>, for the Xtns menu or <None> for none.
  438.  
  439. =item image types
  440.  
  441. The types of images your script will accept. Examples are "RGB", "RGB*",
  442. "GRAY, RGB" etc... Most scripts will want to use "*", meaning "any type".
  443.  
  444. =item the parameter array
  445.  
  446. An array ref containing parameter definitions. These are similar to the
  447. parameter definitions used for C<gimp_install_procedure>, but include an
  448. additional B<default> value used when the caller doesn't supply one, and
  449. optional extra arguments describing some types like C<PF_SLIDER>.
  450.  
  451. Each array element has the form C<[type, name, description, default_value, extra_args]>.
  452.  
  453. <Image>-type plugins get two additional parameters, image (C<PF_IMAGE>) and
  454. drawable (C<PF_DRAWABLE>). Do not specify these yourself. Also, the
  455. C<run_mode> argument is never given to the script, but its value canm be
  456. accessed in the package-global C<$run_mode>. The B<name> is used in the
  457. dialog box as a hint, the B<description> will be used as a tooltip.
  458.  
  459. See the section PARAMETER TYPES for the supported types.
  460.  
  461. =item the return values
  462.  
  463. This is just like the parameter array, just that it describes the return
  464. values. Of course, default values and the enhanced Gimp::Fu parameter
  465. types don't make much sense here. (Even if they did, it's not implemented
  466. anyway..). This argument is optional.
  467.  
  468. If you supply a parameter type (e.g. C<PF_IMAGE>) instead of a full
  469. specification (C<[PF_IMAGE, ...]>), Gimp::Fu might supply some default
  470. values. This is only implemented for C<PF_IMAGE> at the moment.
  471.  
  472. =item the features requirements
  473.  
  474. See L<Gimp::Features> for a description of which features can be checked
  475. for. This argument is optional (but remember to specify an empty return
  476. value array, C<[]>, if you want to specify it).
  477.  
  478. =item the code
  479.  
  480. This is either a anonymous sub declaration (C<sub { your code here; }>, or a
  481. coderef, which is called when the script is run. Arguments (including the
  482. image and drawable for <Image> plug-ins) are supplied automatically.
  483.  
  484. It is good practise to return an image, if the script creates one, or
  485. C<undef>, since the return value is interpreted by Gimp::Fu (like displaying
  486. the image or writing it to disk). If your script creates multiple pictures,
  487. return an array.
  488.  
  489. =back
  490.  
  491. =head2 PARAMETER TYPES
  492.  
  493. =over 2
  494.  
  495. =item PF_INT8, PF_INT16, PF_INT32, PF_INT, PF_FLOAT, PF_STRING, PF_VALUE
  496.  
  497. Are all mapped to a string entry, since perl doesn't really distinguish
  498. between all these datatypes. The reason they exist is to help other scripts
  499. (possibly written in other languages! really!). It's nice to be able to
  500. specify a float as 13.45 instead of "13.45" in C! C<PF_VALUE> is synonymous
  501. to C<PF_STRING>, and <PF_INT> is synonymous to <PF_INT32>.
  502.  
  503. =item PF_COLOR, PF_COLOUR
  504.  
  505. Will accept a colour argument. In dialogs, a colour preview will be created
  506. which will open a colour selection box when clicked.
  507.  
  508. =item PF_IMAGE
  509.  
  510. A gimp image.
  511.  
  512. =item PF_DRAWABLE
  513.  
  514. A gimp drawable (image, channel or layer).
  515.  
  516. =item PF_TOGGLE, PF_BOOL
  517.  
  518. A boolean value (anything perl would accept as true or false). The description
  519. will be used for the toggle-button label!
  520.  
  521. =item PF_SLIDER
  522.  
  523. Uses a horizontal scale. To set the range and stepsize, append an array ref
  524. (see Gtk::Adjustment for an explanation) C<[range_min, range_max, step_size,
  525. page_increment, page_size]> as "extra argument" to the description array.
  526. Default values will be substitued for missing entries, like in:
  527.  
  528.  [PF_SLIDER, "alpha value", "the alpha value", 100, [0, 255, 1] ]
  529.  
  530. =item PF_SPINNER
  531.  
  532. The same as PF_SLIDER, except that this one uses a spinbutton instead of a scale.
  533.  
  534. =item PF_RADIO
  535.  
  536. In addition to a default value, an extra argument describing the various
  537. options I<must> be provided. That extra argument must be a reference
  538. to an array filled with C<Option-Name => Option-Value> pairs. Gimp::Fu
  539. will then generate a horizontal frame with radio buttons, one for each
  540. alternative. For example:
  541.  
  542.  [PF_RADIO, "direction", "the direction to move to", 5, [Left => 5,  Right => 7]]]
  543.  
  544. draws two buttons, when the first (the default, "Left") is activated, 5
  545. will be returned. If the second is activated, 7 is returned.
  546.  
  547. =item PF_FONT
  548.  
  549. Lets the user select a font and returns a X Logical Font Descriptor (XLFD).
  550. The default argument, if specified, must be a full XLFD specification, or a
  551. warning will be printed. Please note that the gimp text functions using
  552. these fontnames (gimp_text_..._fontname) ignore the size. You can extract
  553. the size and dimension by using the C<xlfd_size> function.
  554.  
  555. In older Gimp-Versions a user-supplied string is returned.
  556.  
  557. =item PF_BRUSH, PF_PATTERN, PF_GRADIENT
  558.  
  559. Lets the user select a brush/pattern/gradient whose name is returned as a
  560. string. The default brush/pattern/gradient-name can be preset.
  561.  
  562. =item PF_CUSTOM
  563.  
  564. PF_CUSTOM is for those of you requiring some non-standard-widget. You have
  565. to supply a code reference returning three values as the extra argument:
  566.  
  567.  (widget, settor, gettor)
  568.  
  569. C<widget> is Gtk widget that should be used.
  570.  
  571. C<settor> is a function that takes a single argument, the new value for
  572. the widget (the widget should be updated accordingly).
  573.  
  574. C<gettor> is a function that should return the current value of the widget.
  575.  
  576. While the values can be of any type (as long as it fits into a scalar),
  577. you should be prepared to get a string when the script is started from the
  578. commandline or via the PDB.
  579.  
  580. =item PF_FILE
  581.  
  582. This represents a file system object. It usually is a file, but can be
  583. anything (directory, link). It might not even exist at all.
  584.  
  585. =item PF_TEXT
  586.  
  587. Similar to PF_STRING, but the entry widget is much larger and has Load and
  588. Save buttons.
  589.  
  590. =back
  591.  
  592. =head2 EMBEDDED POD DOCUMENTATION
  593.  
  594. The register functions expects strings (actually scalars) for
  595. documentation, and nobody wants to embed long parts of documentation into
  596. a string, cluttering the whole script.
  597.  
  598. Therefore, Gimp::Fu utilizes the Gimp::Pod module to display the full text
  599. of the pod sections that are embedded in your scripts (see L<perlpod> for
  600. an explanation of the POD documentation format) when the user hits the
  601. "Help" button in the dialog box.
  602.  
  603. Since version 1.094, you can embed specific sections or the full pod
  604. text into any of the blurb, help, author, copyright and date arguments
  605. to the register functions. Gimp::Fu will look into all these strings
  606. for sequences of the form "=pod(section-name)". If found, they will
  607. be replaced by the text of the corresponding section from the pod
  608. documentation. If the named section is not found (or is empty, as in
  609. "=pod()"), the full pod documentation is embedded.
  610.  
  611. Most of the mentioned arguments have default values (see THE REGISTER
  612. FUNCTION) that are used when the arguments are either undefined or empty
  613. strings, making the register call itself much shorter and, IMHO, more
  614. readable.
  615.  
  616. =cut
  617.  
  618. sub register($$$$$$$$$;@) {
  619.    no strict 'refs';
  620.    my($function,$blurb,$help,$author,$copyright,$date,
  621.       $menupath,$imagetypes,$params)=splice(@_,0,9);
  622.    my($results,$features,$code,$type,$defargs);
  623.  
  624.    $results  = (ref $_[0] eq "ARRAY") ? shift : [];
  625.    $features = (ref $_[0] eq "ARRAY") ? shift : [];
  626.    $code = shift;
  627.  
  628.    for($menupath) {
  629.       if (/^<Image>\//) {
  630.          $type = &Gimp::PLUGIN;
  631.          unshift @$params, @image_params;
  632.          $defargs = @image_params;
  633.       } elsif (/^<Load>\//) {
  634.          $type = &Gimp::PLUGIN;
  635.          unshift @$params, @load_params;
  636.          unshift @$results, @load_retvals;
  637.          $defargs = @load_params;
  638.       } elsif (/^<Save>\//) {
  639.          $type = &Gimp::PLUGIN;
  640.          unshift @$params, @save_params;
  641.          $defargs = @save_params;
  642.       } elsif (/^<Toolbox>\//) {
  643.          $type = &Gimp::EXTENSION;
  644.          $defargs = 0;
  645.       } elsif (/^<None>/) {
  646.          $type = &Gimp::EXTENSION;
  647.          $defargs = 0;
  648.       } else {
  649.          die __"menupath _must_ start with <Image>, <Toolbox>, <Load>, <Save> or <None>!";
  650.       }
  651.    }
  652.    undef $menupath if $menupath eq "<None>";#d#
  653.  
  654.    @_==0 or die __"register called with too many or wrong arguments\n";
  655.  
  656.    for my $p (@$params,@$results) {
  657.       next unless ref $p;
  658.       int($p->[0]) eq $p->[0] or croak __"$function: argument/return value '$p->[1]' has illegal type '$p->[0]'";
  659.       $p->[1]=~/^[0-9a-z_]+$/ or carp __"$function: argument name '$p->[1]' contains illegal characters, only 0-9, a-z and _ allowed";
  660.    }
  661.  
  662.    $function="perl_fu_".$function unless $function =~ /^(?:perl_fu_|extension_|plug_in_|file_)/ || $function =~ s/^\+//;
  663.  
  664.    $function=~/^[0-9a-z_]+(-ALT)?$/ or carp __"$function: function name contains unusual characters, good style is to use only 0-9, a-z and _";
  665.  
  666.    Gimp::logger message => __"function name contains dashes instead of underscores",
  667.                 function => $function, fatal => 0
  668.       if $function =~ y/-//;
  669.  
  670.    my $perl_sub = sub {
  671.       $run_mode = shift;    # global!
  672.       my(@pre,@defaults,@lastvals,$input_image);
  673.  
  674.       if (@defaults) {
  675.          for (0..$#{$params}) {
  676.         $params->[$_]->[3]=$defaults[$_];
  677.      }
  678.       }
  679.  
  680.       # supplement default arguments
  681.       for (0..$#{$params}) {
  682.          $_[$_]=$params->[$_]->[3] unless defined($_[$_]);
  683.       }
  684.  
  685.       for($menupath) {
  686.          if (/^<Image>\//) {
  687.             @_ >= 2 or die __"<Image> plug-in called without both image and drawable arguments!\n";
  688.             @pre = (shift,shift);
  689.          } elsif (/^<Toolbox>\// or !defined $menupath) {
  690.             # valid ;)
  691.          } elsif (/^<Load>\//) {
  692.             @_ >= 2 or die __"<Load> plug-in called without the 3 standard arguments!\n";
  693.             @pre = (shift,shift);
  694.          } elsif (/^<Save>\//) {
  695.             @_ >= 4 or die __"<Save> plug-in called without the 5 standard arguments!\n";
  696.             @pre = (shift,shift,shift,shift);
  697.          } elsif (defined $_) {
  698.             die __"menupath _must_ start with <Image>, <Toolbox>, <Load>, <Save> or <None>!";
  699.          }
  700.       }
  701.       if ($run_mode == &Gimp::RUN_INTERACTIVE
  702.           || $run_mode == &Gimp::RUN_WITH_LAST_VALS) {
  703.          my $fudata = $Gimp::Data{"$function/_fu_data"};
  704.  
  705.          if ($run_mode == &Gimp::RUN_WITH_LAST_VALS && $fudata) {
  706.             @_ = @$fudata;
  707.          } else {
  708.             if (@_) {
  709.                # prevent the standard arguments from showing up in interact
  710.                my @hide = splice @$params, 0, scalar@pre;
  711.  
  712.                my $res;
  713.                local $^W=0; # perl -w is braindamaged
  714.                # gimp is braindamaged, is doesn't deliver useful values!!
  715.                ($res,@_)=interact($function,$blurb,$help,$params,@{$fudata});
  716.                return unless $res;
  717.  
  718.                unshift @$params, @hide;
  719.             }
  720.          }
  721.       } elsif ($run_mode == &Gimp::RUN_FULLINTERACTIVE) {
  722.          if (@_) {
  723.             my($res);
  724.             ($res,@_)=interact($function,$blurb,$help,$params,@pre,@_);
  725.             undef @pre;
  726.             return unless $res;
  727.          }
  728.       } elsif ($run_mode == &Gimp::RUN_NONINTERACTIVE) {
  729.          # nop
  730.       } else {
  731.          die __"run_mode must be INTERACTIVE, NONINTERACTIVE or RUN_WITH_LAST_VALS\n";
  732.       }
  733.       $input_image = $_[0]   if ref $_[0]   eq "Gimp::Image";
  734.       $input_image = $pre[0] if ref $pre[0] eq "Gimp::Image";
  735.  
  736.       $Gimp::Data{"$function/_fu_data"}=[@_];
  737.  
  738.       print $function,"(",join(",",(@pre,@_)),")\n" if $Gimp::verbose;
  739.  
  740.       Gimp::set_trace ($old_trace);
  741.       my @imgs = &$code(@pre,@_);
  742.       $old_trace = Gimp::set_trace (0);
  743.  
  744.       if ($menupath !~ /^<Load>\//) {
  745.          if (@imgs) {
  746.             for my $i (0..$#imgs) {
  747.                my $img = $imgs[$i];
  748.                next unless defined $img;
  749.                if (ref $img eq "Gimp::Image") {
  750.                   if ($outputfile) {
  751.                      my $path = sprintf $outputfile,$i;
  752.                      if ($#imgs and $path eq $outputfile) {
  753.                         $path=~s/\.(?=[^.]*$)/$i./; # insert image number before last dot
  754.                      }
  755.                      print "saving image $path\n" if $Gimp::verbose;
  756.                      save_image($img,$path);
  757.                      $img->delete;
  758.                   } elsif ($run_mode != &Gimp::RUN_NONINTERACTIVE) {
  759.                      $img->display_new unless $input_image && $$img == $$input_image;
  760.                   }
  761.                } elsif (!@$results) {
  762.                   warn __"WARNING: $function returned something that is not an image: \"$img\"\n";
  763.                }
  764.             }
  765.          }
  766.          Gimp->displays_flush;
  767.       }
  768.  
  769.       Gimp::set_trace ($old_trace);
  770.       wantarray ? @imgs : $imgs[0];
  771.    };
  772.  
  773.    Gimp::register_callback($function,$perl_sub);
  774.    push(@scripts,[$perl_sub,$function,$blurb,$help,$author,$copyright,$date,
  775.                   $menupath,$imagetypes,$params,$results,$features,$code,$type,
  776.                   $defargs]);
  777. }
  778.  
  779. =cut
  780.  
  781. =head2 MISC. FUNCTIONS
  782.  
  783. =over
  784.  
  785. =item C<save_image(img,options_and_path)>
  786.  
  787. This is the internal function used to save images. As it does more than just
  788. gimp_file_save, I thought it would be handy in other circumstances as well.
  789.  
  790. The C<img> is the image you want to save (which might get changed during
  791. the operation!), C<options_and_path> denotes the filename and optinal
  792. options. If there are no options, C<save_image> tries to deduce the filetype
  793. from the extension. The syntax for options is
  794.  
  795.  [IMAGETYPE[OPTIONS...]:]filespec
  796.  
  797. IMAGETYPE is one of GIF, JPG, JPEG, PNM or PNG, options include
  798.  
  799.  options valid for all images
  800.  +F    flatten the image (default depends on the image)
  801.  -F    do not flatten the image
  802.  
  803.  options for GIF and PNG images
  804.  +I    do save as interlaced (GIF only)
  805.  -I    do not save as interlaced (default)
  806.  
  807.  options for GIF animations (use with -F)
  808.  +L    save as looping animation
  809.  -L    save as non-looping animation (default)
  810.  -Dn    default frame delay (default is 0)
  811.  -Pn    frame disposal method: 0=don't care, 1 = combine, 2 = replace
  812.  
  813.  options for PNG images
  814.  -Cn    use compression level n
  815.  -E    Do not skip ancillary chunks (default)
  816.  +E    Skip ancillary chunks
  817.  
  818.  options for JPEG images
  819.  -Qn    use quality "n" to save file (JPEG only)
  820.  -S    do not smooth (default)
  821.  +S    smooth before saving
  822.  
  823. some examples:
  824.  
  825.  test.jpg        save the image as a simple jpeg
  826.  JPG:test.jpg        same
  827.  JPG-Q70:test.jpg    the same but force a quality of 70
  828.  GIF-I-F:test.jpg    save a gif image(!) named test.jpg
  829.              non-inerlaced and without flattening
  830.  
  831. =back
  832.  
  833. =cut
  834.  
  835. sub save_image($$) {
  836.    my($img,$path)=@_;
  837.    my($interlace,$flatten,$quality,$type,$smooth,$compress,$loop,$dispose);
  838.  
  839.    $interlace=0;
  840.    $quality=0.75;
  841.    $smooth=0;
  842.    $compress=7;
  843.    $loop=0;
  844.    $delay=0;
  845.    $dispose=0;
  846.    $noextra=0;
  847.  
  848.    $_=$path=~s/^([^:]+):// ? $1 : "";
  849.    $type=uc($1) if $path=~/\.([^.]+)$/;
  850.    $type=uc($1) if s/^(GIF|JPG|JPEG|PNM|PNG)//i;
  851.    while($_ ne "") {
  852.       $interlace=$1 eq "+",     next if s/^([-+])[iI]//;
  853.       $flatten=$1 eq "+",     next if s/^([-+])[fF]//;
  854.       $noextra=$1 eq "+",    next if s/^([-+])[eE]//;
  855.       $smooth=$1 eq "+",     next if s/^([-+])[sS]//;
  856.       $quality=$1*0.01,        next if s/^-[qQ](\d+)//;
  857.       $compress=$1,        next if s/^-[cC](\d+)//;
  858.       $loop=$1 eq "+",        next if s/^([-+])[lL]//;
  859.       $delay=$1,        next if s/^-[dD](\d+)//;
  860.       $dispose=$1,        next if s/^-[pP](\d+)//;
  861.       croak __"$_: unknown/illegal file-save option";
  862.    }
  863.    $flatten=(()=$img->get_layers)>1 unless defined $flatten;
  864.  
  865.    $img->flatten if $flatten;
  866.  
  867.    # always save the active layer
  868.    my $layer = $img->get_active_layer;
  869.  
  870.    if ($type eq "JPG" or $type eq "JPEG") {
  871.       eval { $layer->file_jpeg_save($path,$path,$quality,$smooth,1) };
  872.       $layer->file_jpeg_save($path,$path,$quality,$smooth,1,$interlace,"",0,1,0,0) if $@;
  873.    } elsif ($type eq "GIF") {
  874.       unless ($layer->is_indexed) {
  875.          eval { $img->convert_indexed(1,256) };
  876.          $img->convert_indexed(2,&Gimp::MAKE_PALETTE,256,1,1,"") if $@;
  877.       }
  878.       $layer->file_gif_save($path,$path,$interlace,$loop,$delay,$dispose);
  879.    } elsif ($type eq "PNG") {
  880.       $layer->file_png_save($path,$path,$interlace,$compress,(!$noextra) x 5);
  881.    } elsif ($type eq "PNM") {
  882.       $layer->file_pnm_save($path,$path,1);
  883.    } else {
  884.       $layer->gimp_file_save($path,$path);
  885.    }
  886. }
  887.  
  888. # provide some clues ;)
  889. sub print_switches {
  890.    my($this)=@_;
  891.    for(@{$this->[9]}) {
  892.       my $type=$pf_type2string{$_->[0]};
  893.       my $key=mangle_key($_->[1]);
  894.       printf "           -%-25s %s%s\n","$key $type",$_->[2],defined $_->[3] ? " [$_->[3]]" : "";
  895.    }
  896. }
  897.  
  898. sub main {
  899.    $old_trace = Gimp::set_trace (0);
  900.    if ($Gimp::help) {
  901.       my $this=this_script;
  902.       print __"       interface-arguments are
  903.            -o | --output <filespec>   write image to disk, don't display
  904.            -i | --interact            let the user edit the values first
  905.        script-arguments are
  906. ";
  907.       print_switches ($this);
  908.    } else {
  909.       Gimp::main;
  910.    }
  911. }
  912.  
  913. 1;
  914. __END__
  915.  
  916. =head1 AUTHOR
  917.  
  918. Marc Lehmann <pcg@goof.com>
  919.  
  920. =head1 SEE ALSO
  921.  
  922. perl(1), L<Gimp>.
  923.  
  924. =cut
  925.